home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / acdcmp.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  3.1 KB  |  88 lines
  1.       subroutine acdcmp
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine performs an lu factorization of the circuit equation
  5. c coefficient matrix.
  6. c
  7. c spice version 2g.6  sccsid=tabinf 3/15/83
  8.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  9.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  10.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  11.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  12.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  13.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  14.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  15.      7   irowno,jcolno,nttbr,nttar,lvntmp
  16. c spice version 2g.6  sccsid=cirdat 3/15/83
  17.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  18.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  19. c spice version 2g.6  sccsid=flags 3/15/83
  20.       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
  21.      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
  22. c spice version 2g.6  sccsid=knstnt 3/15/83
  23.       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
  24.      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox,
  25.      2   pivtol,pivrel
  26. c spice version 2g.6  sccsid=blank 3/15/83
  27.       common /blank/ value(200000)
  28. c spice version 2g.6  sccsid=status 3/15/83
  29.       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
  30.      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
  31.      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
  32.       integer nodplc(64)
  33.       complex cvalue(32)
  34.       equivalence (value(1),nodplc(1),cvalue(1))
  35. c
  36.       n=1
  37.    10 n=n+1
  38.       nxti=n
  39.       nxtj=n
  40. c
  41. c     calculate contribution from (nxti,nxtj)
  42. c
  43.       if (n.ge.nstop) return
  44.       n1=nodplc(irswpf+nxti)
  45.       n2=nodplc(icswpf+nxtj)
  46.       locnn=indxx(n1,n2)
  47.       gdiag=dabs(value(lynl+locnn))+dabs(value(imynl+locnn))
  48.       if (gdiag.ge.pivtol) go to 20
  49.       value(lynl+locnn)=pivtol
  50.       value(imynl+locnn)=0.0d0
  51.       write(iofile,11) n
  52.    11 format(1h0,' underflow occured at step n= ',i5)
  53. c
  54. c     down col j
  55. c
  56.    20 locr=nodplc(irpt+locnn)
  57.    25 if (locr.eq.0) go to 10
  58.       i=nodplc(irowno+locr)
  59.       call cdiv(value(lynl+locr),value(imynl+locr),value(lynl+locnn),
  60.      1     value(imynl+locnn),value(lynl+locr),value(imynl+locr))
  61.       locc=nodplc(jcpt+locnn)
  62. c
  63. c     for each element look up row nxti
  64. c
  65.    30 if (locc.eq.0) go to 70
  66.       j=nodplc(jcolno+locc)
  67. c
  68. c     locate element (i,j)
  69. c
  70.    35 if (j.lt.i) go to 45
  71.       locij=locc
  72.    40 locij=nodplc(irpt+locij)
  73.       if (nodplc(irowno+locij).eq.i) go to 55
  74.       go to 40
  75.    45 locij=locr
  76.    50 locij=nodplc(jcpt+locij)
  77.       if (nodplc(jcolno+locij).eq.j) go to 55
  78.       go to 50
  79.    55 call cmult(value(lynl+locc),value(imynl+locc),
  80.      1     value(lynl+locr),value(imynl+locr),xreal,ximag)
  81.       value(lynl+locij)=value(lynl+locij)-xreal
  82.       value(imynl+locij)=value(imynl+locij)-ximag
  83.       locc=nodplc(jcpt+locc)
  84.       go to 30
  85.    70 locr=nodplc(irpt+locr)
  86.       go to 25
  87.       end
  88.